{-
Copyright (c) 2007, Enrico Franchi
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1) Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2) Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3) Neither my name nor the names of its contributors may be used to
endorse or promote products derived from this software without specific
prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}

module Main where

import IO
import Hydra
import HydraParser
import Utils (chomp)

import Data.Maybe
import System.Console.Readline
import System.CPUTime

data Command = Load   String
             | Run    String
             | Step   String
             | Stop
             | CommandError String
             | Help
             | Quit
             | Pass
               deriving (Show, Eq)

versionString :: String
versionString = "0.1"

bannerString :: String
bannerString = "    __    __              __          "    ++ "\n" ++
               "   / /_  / /_  __  ______/ /________ _"    ++ "    Hhydra, version "
                                                           ++ versionString ++ "\n" ++
               "  / __ \\/ __ \\/ / / / __  / ___/ __ `/"  ++ "    http://code.google.com/p/hhydra/\n" ++
               " / / / / / / / /_/ / /_/ / /  / /_/ / "    ++ "    Type help for help.\n" ++
               "/_/ /_/_/ /_/\\__, /\\__,_/_/   \\__,_/  " ++  "    Copyright 2007 Enrico Franchi(c)\n" ++
               "            /____/\n"

separatorLine :: String
separatorLine = (replicate 80 '=') ++ "\n"

helpString :: String
helpString = "\n" ++ separatorLine ++
             " Help for hydra tool. \n" ++
             separatorLine ++
             "\n Hydras are specified with parentesis. Parenteses that contain\n" ++
             " no other parentesis are heads.\n" ++
             " (()()) is an hydra with two heads that are connected directly\n" ++
             " to the root.\n" ++
             " o  o \n" ++
             "  \\/  \n" ++
             "\n" ++
             separatorLine ++
             " run hydra : creates and tries to slay the specified hydra\n" ++
             " help      : shows this help\n" ++
             " quit      : quits hhydra\n" ++
             separatorLine

matchCommand command =
    case command of
      ('h':'e':'l':'p':rest) -> Help
      ('h':[])               -> Help
      ('r':'u':'n':rest)     -> Run rest
      ('r':' ':rest)         -> Run rest
      ('s':'t':'e':'p':rest) -> Step rest
      ('s':'t':'o':'p':rest) -> Stop
      ('q':'u':'i':'t':rest) -> Quit
      ('q':[])               -> Quit
      []                     -> Pass
      rest                   -> CommandError rest

executeCommand :: Command -> IO ()
executeCommand (Run text) =
    do
      let h = hydra text;
      start <- getCPUTime;
      let hits = slayHydra h;
      putStr ("Hercules hit the hydra " ++ (show hits) ++ " times in ");
      end <- getCPUTime;
      putStrLn ((show ((end-start) `div` 1000000000)) ++ " milliseconds.");
executeCommand (CommandError err) =
    do
      putStr "Unable to process command \"";
      putStr   (head (words err));
      putStrLn "\""
executeCommand Pass = return ()
executeCommand Help = putStrLn helpString
executeCommand (Step text) =
    putStrLn "\nCommand `stop` interrupts computation.\n" >>
    step 0 (hydra text)
    where
      step n hydra = case hydra of
                     (Root bs) ->
                         do
                           putStrLn ('\n':(prettyShow hydra));
                           let (done, hydra') = (chopHead hydra);
                           (if done then
                                do
                                  c <- readline "step> ";
                                  let c'     = fromMaybe "quit" c;
                                  let action = matchCommand c';
                                  (if action == Stop then (return ()) else (step (n+1) hydra'))
                            else putStrLn ("Finished: Hercules hit the hydra " ++ (show n) ++ " times."));

runLoop =
    do
      s <- readline "> ";
      -- ctrl-d makes it go out
      s' <-  maybe (return "quit") remember s;
      let command = matchCommand (chomp s');
      reRun command
    where
      remember :: String -> IO String
      remember line = do
        addHistory line;
        return line
      reRun :: Command -> IO ()
      reRun Quit = return ()
      reRun command =
          do
            executeCommand command
            runLoop

main = 
    do
      putStr bannerString;
      runLoop